home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS in a Box 7
/
BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso
/
Files
/
Prog
/
Q-R
/
RR⁄Tabby Source Code.cpt
/
Export 3.21.source
< prev
next >
Wrap
Text File
|
1990-05-25
|
64KB
|
2,018 lines
' Code by: Mike Lininger
' 385 Bowling Green Place
' Gahanna, Ohio 43230
' (614) 471-6209 (BBS)
5-25-90
I am making most of my code available to anyone interested in developing
their own Second Sight/Tabby utilities. This source is not designed to be
compiled and run. It is missing key functions and pieces of code that are
Copyright me and others, that are not to be released at this time.
This code is for example purposes only. It illustrates various ways of reading
writing and process data from a variety of SS/Tabby files. It illustrates
the use of Block Reads and Indexes amoung other things.
If you use any portion of this code you must abide by two rules, or you
void the agreement that I am making with you and are subject what the law
dictates.
They are simple.
1. If you us any of this code you must give Michael Lininger and Lininger
Technology credit in both the program and the documentation.
2. It is agreed I am to receive a free copy of the program whether it is
free, sharware or commercial.
Now you must read on a little further and we will be done.
A little history on why I choose ZBasic as the root for my utilities.
I use to be one of those people that would smirk every time someone mentioned
they were using BASIC (until 3 years ago I and others had ever right to
smirk) and would say how nice. But thought yeh! Real programmers only use
C or Assembler.
Then came along Microsofts QuickBasic for the IBM. This baby was hot
it gave you all features of C and Pascal, plus core logic of Assembler,
all packaged into a neat super easy to learn and use package. This cut out
months of development work plus the finial applications were a hell of a lot
better looking, cause you could do so much in a short period of time.
This set the tide for a new generation of Basic's. Zedcor introduced ZBasic
for the mac, which gave complete control over the toolbox plus it compiled
into nice neat assembly and was fast.
ZBasic I have found to be extremely powerful and fast, in most cases it
matches or out performs the best C compilers out there. Now when someone
says heh I finished this great C project that I have been working on for 6
months, I now smirk and say how nice. But think yeh! I could have done
the same thing in 1/4 the time and saved you 300,000.00 and ended up with
a lot cleaner and more professional looking product all at the cost of an
extra 14k of file size.
The only draw back to ZBasic is it lack of Data structures, but this is
made up for the use of Indexes. C programmer salivate all over the place
at the mention of theses babies. They give you performance you never dreamed
of. Now of we could just get Zedcor to give us a dozen more, WOW.
Moral of the story - DO NOT EVER underestimate the POWER of Compiled Basic.
Have at it. I hope a lot of people will use this as a jumping off point
and dive into creating a flood of new SS/Tabby utilities.
I can be reached on the networks if you have questions.
614-471-6209 9600 baud
614-471-5733 2400 baud
M.Lininger Genie
Mike Lininger FidoNet (Tabby, RRH, MANSION echoes)
Mike Lininger 1:226/200
Mike Lininger via cmhGate - Net 226 fido<=>uucp gateway Col, OH
UUCP: ...!ous-cis!n8emr!cmhgate!200.2!Mike.Lininger
INET: Mike.Lininger@p2.f200.n226.z1.FIDONET.ORG
' Code is in ZBasic 5.0
' Michael Lininger (Lininger Technology)
' Code is provided AS IS
' Start date: 3-25-89
' Last modify date: 1-26-90
' Version: 3.21 Release
' Export Module for Tabby 2.1x
' MKLx - Creator
' TExp - Type
' To Prevent your application from say "You will not be able to print"
' if it does not find a Print Driver in your system do the following
' on the finial campiled application. DO NOT DO IT ON ZBASIC ITSELF.
' Use FEDIT do a Hex search for 50EDFD3C and change 50ED to FD3C.
' Sets up application. Turns off Startup Window, Sets Default Mouse
WINDOW OFF
COORDINATE WINDOW
DEF MOUSE=-1
WIDTH -2
FLUSHEVENTS
ON ERROR GOSUB 65535
' Define Arrays that will be needed throughout the application
DIM 50 Tabby$(100)
DIM 25 MsgName$(255)
DIM 80 Sign$(10), b$(5)
DIM 1 MsgType$(255),1 MessageSection$(255)
DIM SectionCount%(255), ExportCount%(255)
DIM t%,l%,b%,r%
DIM HelpT%,HelpL%,HelpB%,HelpR%
DIM b%(11)
DIM 32 AKAName$(100)
DIM 11 AKANode$(100)
' Record structure and equates for
' Catalog Information Parameter Block Record (CInfoPBRec$)
' - ---- - - ---
DIM CInfoPBRec$
CInfoPBRecPtr&=VARPTR(CInfoPBRec$)
DIM DirectoryName$, FullPathName$
IONamePtr&=VARPTR(DirectoryName$)
FSRtDir&=2&
' Record structure and equates for
' Working Directory Parameter Block Record (WDPBRec$)
' - - - - ---
DIM WDPBRec$
WDPBRecPtr&=VARPTR(WDPBRec$)
True=NOT False
' Functions that are used by the application
' ------------------------------------------
LONG FN ScrollingHelp(RectPtr&,ResID%,HelpBtn%)
'This function has been removed.
'This function is copyright Ariel Publishing
'This function is from the Function Junction Package offered
'by Ariel Publishing. For more info call 509-923-2249
END FN
LONG FN FormatWnd(WndToFormat%)
'This function has been removed.
'This function is copyright Ariel Publishing
'This function is from the Function Junction Package offered
'by Ariel Publishing. For more info call 509-923-2249
LONG IF WndToFormat% <> 3
GOSUB "Format_Window"
END IF
END FN
LONG FN PathNameFromDirID$(DirID&,WDRefNum%)
FullPathName$=""
This function determines the pathname for a file dd80:bbs:Mike
'This function has been removed.
'This function is copyright Ariel Publishing
'This function is from the Function Junction Package offered
'by Ariel Publishing. For more info call 509-923-2249
END FN=FullPathName$
LONG FN ConvertWDRef$(FileName$,WDRefNum%)
This function determines the pathname for a file dd80:bbs:Mike
'This function has been removed.
'This function is copyright Ariel Publishing
'This function is from the Function Junction Package offered
'by Ariel Publishing. For more info call 509-923-2249
END FN=FN PathNameFromDirID$(IOWDDirID&,IOWDVRefNum%)+FileName$
' This function turns a Pascal-encoded string into ZBasic-usable form
DEF FN MakeString$(String$) = MID$(String$, 2, ASC(LEFT$(String$,1)))
' convert string resource to a string, handle must be passed to this function
LONG FN ReturnString$(SHndl&)
FByte%=PEEK(PEEK LONG(SHndl&))
String$=""
FOR I%=1 TO FByte%
String$=String$+CHR$(PEEK(PEEK LONG(SHndl&)+I%))
NEXT I%
END FN = String$
' ------------------------------------------
"Export_Start"
APPLE MENU "Export 3.21"
MENU 1,0,1,"File"
MENU 1,1,1, "Michael Lininger"
MENU 1,2,1, "Lininger Technology"
MENU 1,3,1, "385 Bowling Green Place"
MENU 1,4,1, "Gahanna, Ohio 43230"
EDIT MENU 2
MENU 3,0,0,"Aurora Borealis 614-471-6209"
' Loads starting values and pathnames from Str Resource file
Cur%=128:LErr%=0
GOSUB "Get_Resource_Values"
GOSUB "Cursor_Spin"
' Checks to see if mouse key is down, if so then goto configure menu
MOUSE ON
DEF MOUSE = 0
Hold%=MOUSE(3)
LONG IF Hold% <> 0
GOSUB "Cursor_Spin"
DEF MOUSE = -1
GOSUB "Configure_Menu"
IF rscs%=1 THEN rscs%=0:CALL CLOSERESFILE(Refnum%)
CURSOR 0
END
END IF
MOUSE OFF
DEF MOUSE = -1
GOSUB "Build_Main_Window"
GOSUB "Cursor_Spin"
IF LEN(BBSFolder$) <=1 THEN BBSFolder$=""
IF RRHost$="" THEN RRHost$="Red Ryder Host"
GenericFile$=BBSFolder$+"Generic"
ConfigFile$=BBSFolder$+"Config"
RRHost$=BBSFolder$+RRHost$
TabbyNet$=BBSFolder$+"TabbyNet"
NextLaunch$=BBSFolder$+"Launch.Next"
TabbyConfig$=BBSFolder$+"Tabby:Tabby Config"
TabbyAreas$=BBSFolder$+"Tabby:Areas.bbs"
IF INSTR(1,AKAFile$,":") = 0 THEN AKAFile$=BBSFolder$+AKAFile$
TotalBytes&=0
GOSUB "Get_Tabby_Files"
GExport$=GenericFile$+"Generic Export"
GImport$=GenericFile$+"Generic Import"
GEchoes$=GenericFile$+"Generic Echoes"
GSeenby$=GenericFile$+"Seenby.bbs"
GOSUB "Cursor_Spin"
GOSUB "Config_Read"
GOSUB "Messages_Read"
a&=659200
d&=32000
overhead&=c&+d&
n&=a&+overhead&
ERROR = 0
LONG IF b%(1) = 2
ErrCode%=1
OPEN "N",1,MsgHdrFilename$
MsgHdrSize& = LOF(1,1)
CLOSE #1
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
m&=MEM(-1)
LONG IF MsgHdrSize&+overhead& < m&
a&=MsgHdrSize&
XELSE
GOSUB "Memory_Check"
END IF
XELSE
a&=206000
LONG IF a&+overhead& < m&
GOSUB "Memory_Check"
END IF
END IF
CLEAR a&,0
CLEAR d&,1
GOSUB "Cursor_Spin"
R_MsgCount&=a&
StartTime$=DATE$+" "+TIME$+" Export Start"
STime&=TIMER
RecStart&=1
ERROR = 0
LONG IF b%(1) = 1
ErrCode%=1
ReNumber%=1:ReStart%=1
OPEN "N",1,MsgHdrFilename$,206
ax&=LOF(1,1)
RecCount&=ax&/206
LowBound&=0:HiBound&=RecCount&:FoundIt%=0
' Original idea for this binary search was from Pete Johnson
WHILE ((HiBound&-LowBound&) > 1) AND (FoundIt%=0)
Rct&=(LowBound&+HiBound&)/2
RECORD #1,Rct&,2
READ #1,MessageNumber&
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
LONG IF MessageNumber& > OldHighMessage&
HiBound&=Rct&
XELSE
LONG IF MessageNumber& < OldHighMessage&
LowBound&=Rct&
XELSE
RecStart&=Rct&
FoundIt%=1
END IF
END IF
WEND
CLOSE #1
END IF
ERROR = 0
ErrCode%=3
OPEN "N",1,MsgHdrFilename$
R_MsgLength&=LOF(1,1)
MsgCnt&=R_MsgLength&/206
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
LONG IF R_MsgLength& < R_MsgCount&
R_MsgCount&=R_MsgLength&
END IF
MsgSkip&=(RecStart&*206)-206
LONG IF (R_MsgLength&-MsgSkip&) < R_MsgCount&
R_MsgCount&=R_MsgLength&-MsgSkip&
END IF
Position&=MsgSkip&
IF Position& <= 0 THEN Position&=0:Full%=1
BytesLeft&=R_MsgLength&
TotalBytes&=Position&
GOSUB "Cursor_Spin"
ERROR = 0
ErrCode%=4
OPEN "N",2,MsgTxtFilename$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ERROR = 0:ErrCode%=5
DEF OPEN "TEXTEDIT"
OPEN "A",5,GExport$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ERROR = 0:ErrCode%=6
DEF OPEN "TEXTEDIT"
OPEN "A",7,GSeenby$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ERROR = 0:ErrCode%=7
DEF OPEN "TEXTEDIT"
OPEN "A",4,GEchoes$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
TotalBytes&=0:Graph%=1:ScanCount%=0
ERROR = 0
WHILE NOT EOF(1)
ErrCode%=8
RECORD #1,0,Position&
READ FILE #1,MEM(0+40),R_MsgCount&
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
RecordCount%=R_MsgCount&/206
x&=0
FOR fCnt%=1 TO RecordCount%
ScanCount&=ScanCount&+1
Status$=CHR$(PEEK(MEM(0+40)+x&))
Section%=CVI(CHR$(PEEK(MEM(0+40)+x&+6)))
MsgNumber&=PEEK LONG(MEM(0+40)+x&+2)
MessageOffSet&=PEEK LONG(MEM(0+40)+x&+188)
MessageLength&=PEEK LONG(MEM(0+40)+x&+192)
ReplyNumber&=PEEK LONG(MEM(0+40)+x&+196)
MessageType%=VAL(MessageSection$(Section%))
SectionCount%(Section%)=SectionCount%(Section%)+1
LONG IF ((ASC(Status$) AND 1) <> 1): 'Not Deleted
LONG IF MessageType%=3 OR MessageType%=4: 'Valid Section
LONG IF ((ASC(Status$) AND 64) <> 64): ' Not Already Echo Processed
GOSUB "Export_Message"
BitSet%=255
Status%=ASC(Status$)
Status%=Status%+64
LONG IF b%(2)=2
IF Section%=NetMailArea% THEN Status%=Status%+1
END IF
POKE MEM(0+40)+x&,Status%
END IF
END IF
XELSE
IF ((ASC(Status$) AND 64) <> 64) AND (MessageType%=3 OR MessageType%=4) THEN DeleteCount&=DeleteCount&+1
END IF
x&=x&+206
TotalBytes&=TotalBytes&+206
Graph%=Graph%+1
LONG IF Graph%=45 OR (Graph%=10 AND b%(1)=1)
PEN ,,1,9,3
Graph%=1
x!=TotalBytes&/R_MsgLength&
x!=x!*100
Brad%=x!*2.55
CIRCLE FILL 130,23,14 TO 0,Brad%
GOSUB "Cursor_Spin"
END IF
NEXT fCnt%
LONG IF BitSet%=255
ERROR = 0:ErrCode%=9
RECORD #1,0,Position&
WRITE FILE #1,MEM(0+40),R_MsgCount&
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
END IF
BitSet%=0
Position&=Position&+R_MsgCount&
BytesLeft&=BytesLeft&-R_MsgCount&
LONG IF Position&+R_MsgCount& > R_MsgLength&
R_MsgCount& = R_MsgLength&-Position&
END IF
IF R_MsgCount& <= 0 THEN R_MsgCount&=100000
GOSUB "Cursor_Spin"
WEND
SFTime$=DATE$+" "+TIME$
PEN ,,1,9,3
Brad%=255
CIRCLE FILL 130,23,14 TO 0,Brad%
GOSUB "Cursor_Spin"
CLOSE #1:CLOSE #2:CLOSE #5:CLOSE #4:CLOSE #7
RESET
FinishTime$=DATE$+" "+TIME$+" Export Finish"
FTime&=TIMER
LONG IF b%(3)=2
GOSUB "Notify_Sysop"
END IF
LONG IF b%(6)=2
GOSUB "Log_Report"
END IF
default$=STR$(HighMessage&)
default$=RIGHT$(default$,LEN(default$)-1)
ResourceCount%=1233
StrHnd&=FN GETRESOURCE(CVI("STR "),ResourceCount%)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
GOSUB "Cursor_Spin"
bCnt%=2
FOR j% = 1253 TO 1256
default$=b$(bCnt%)
StrHnd&=FN GETRESOURCE(CVI("STR "),j%)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
bCnt%=bCnt%+1
NEXT j%
default$=DATE$+" "+TIME$+STR$(ScanCount&)+" msgs scanned,"+STR$(ExportCount&)+ " exported, in"+STR$(FTime&-STime&)+" seconds"
ResourceCount%=1257
StrHnd&=FN GETRESOURCE(CVI("STR "),ResourceCount%)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
GOSUB "Tabby_Launch"
RESET
END
"Log_Report"
LONG IF b%(7)=1
ERROR = 0 :ErrCode%=10
DEF OPEN "TEXTEDIT"
OPEN "A",6,ReportLog$
PRINT #6,StartTime$
PRINT #6,SFTime$;STR$(ExportCount%);" messages exported"
PRINT #6,FinishTime$
CLOSE #6
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
XELSE
LONG IF b%(8)=2
ERROR = 0:ErrCode%=11
DEF OPEN "TEXTEDIT"
OPEN "O",6,ReportLog$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
XELSE
Error=0:ErrCode%=12
DEF OPEN "TEXTEDIT"
OPEN "A",6,ReportLog$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
END IF
ERROR = 0:ErrCode%=13
PRINT #6, StartTime$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
GOSUB "LogWrite"
ERROR = 0:ErrCode%=14
FOR j%= 1 TO 255
LONG IF ExportCount%(j%) <> 0
PRINT #6, USING "########";ExportCount%(j%);
IF MsgName$(j%)="" THEN MsgName$(j%)="Inactive Area"
PRINT #6, " ";:PRINT #6,MsgName$(j%)
END IF
NEXT j%
PRINT #6,FinishTime$
PRINT #6,"---------------"
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
CLOSE #6
END IF
RETURN
"LogWrite"
ERROR = 0:ErrCode%=15
PRINT #6, USING "########";ScanCount&;:PRINT #6," Messages Scanned"
PRINT #6, USING "########";ExportCount&;:PRINT #6," Messages Exported"
PRINT #6, USING "########";EchoCount&;:PRINT #6," Echo Messages Exported"
PRINT #6, USING "########";NetCount&;:PRINT #6," NetMail Messages Exported"
PRINT #6, USING "########";DeleteCount&;:PRINT #6," Deleted Mail NOT Exported"
PRINT #6, USING "########";Point%;:PRINT #6," Reply Mail to Points"
PRINT #6, USING "########";EBytes&;:PRINT #6," Total Bytes Exported"
PRINT #6, USING "########";(FTime&-STime&);:PRINT #6," Elapsed Time (Seconds)"
PRINT #6, USING "########";LowMessage&;:PRINT #6," Low Message Number"
PRINT #6, USING "########";HighMessage&;:PRINT #6," High Message Number"
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
RETURN
"Notify_Sysop"
ERROR = 0:ErrCode%=16
DEF OPEN "TEXTEDIT"
OPEN "A",6,GImport$
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
Catagory$=STR$(NetMailArea%)
Catagory$=RIGHT$(Catagory$,LEN(Catagory$)-1)
FOR k%= LEN(Catagory$) TO 2
Catagory$="0"+Catagory$
NEXT k%
a$=LEFT$(DATE$,2)+"/"
a$=a$+MID$(DATE$,4,2)+"/"
a$=a$+RIGHT$(DATE$,2)
b$=LEFT$(TIME$,2)+":"
b$=b$+MID$(TIME$,4,2)+":"
b$=b$+RIGHT$(TIME$,2)
ERROR = 0:ErrCode%=17
PRINT #6,".M.";CHR$(13);
PRINT #6,Catagory$;CHR$(13);
PRINT #6,a$;CHR$(13);
PRINT #6,b$;CHR$(13);
PRINT #6,"";CHR$(13);
PRINT #6,"Export Engine 3.2";CHR$(13);
PRINT #6,SysopName$;CHR$(13);
PRINT #6,"Export 3.2 Report "+TIME$;CHR$(13);
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ERROR = 0:ErrCode%=18
FOR j% = 1 TO 5
PRINT #6, b$(j%);CHR$(13);
NEXT j%
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ERROR = 0:ErrCode%=19
PRINT #6,"";CHR$(13);
PRINT #6,StartTime$;CHR$(13);
PRINT #6,FinishTime$;CHR$(13);
PRINT #6,"";CHR$(13);
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
GOSUB "LogWrite"
ICnt%=0
ERROR = 0:ErrCode%=20
FOR j% = 1 TO 255
LONG IF ExportCount%(j%) <> 0
PRINT #6, USING "########";ExportCount%(j%);
IF MsgName$(j%)="" THEN MsgName$(j%)="Inactive Area"
ax$=MsgName$(j%)+SPACE$(25)
PRINT #6, " ";:PRINT #6,LEFT$(ax$,25);
ICnt%=ICnt%+1
LONG IF ICnt%=2
PRINT #6,CHR$(13);
ICnt%=0
XELSE
PRINT #6," ";
END IF
END IF
NEXT j%
IF ICnt%=1 THEN PRINT #6,CHR$(13);
PRINT #6,CHR$(0);CHR$(13);
CLOSE #6
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
RETURN
"Export_Message"
a%=CVI(CHR$(PEEK(MEM(0+40)+x&+200))):GOSUB "Date_Convert":Month$=a$
a%=CVI(CHR$(PEEK(MEM(0+40)+x&+201))):GOSUB "Date_Convert":Day$=a$
a%=CVI(CHR$(PEEK(MEM(0+40)+x&+202))):GOSUB "Date_Convert":Year$=a$
a%=CVI(CHR$(PEEK(MEM(0+40)+x&+203))):GOSUB "Date_Convert":Hour$=a$
a%=CVI(CHR$(PEEK(MEM(0+40)+x&+204))):GOSUB "Date_Convert":Minute$=a$
a%=CVI(CHR$(PEEK(MEM(0+40)+x&+205))):GOSUB "Date_Convert":Second$=a$
To$="":From$="":Subject$="":Destination$=""
l%=CVI(CHR$(PEEK(MEM(0+40)+x&+46)))
EBytes&=EBytes&+l%
FOR k%=1 TO l%
To$=To$+CHR$(PEEK(MEM(0+40)+x&+46+k%))
NEXT k%
l%=CVI(CHR$(PEEK(MEM(0+40)+x&+14)))
EBytes&=EBytes&+l%
FOR k%=1 TO l%
From$=From$+CHR$(PEEK(MEM(0+40)+x&+14+k%))
NEXT k%
l%=CVI(CHR$(PEEK(MEM(0+40)+x&+78)))
EBytes&=EBytes&+l%
FOR k%=1 TO l%
Subject$=Subject$+CHR$(PEEK(MEM(0+40)+x&+78+k%))
NEXT k%
l%=CVI(CHR$(PEEK(MEM(0+40)+x&+120)))
EBytes&=EBytes&+l%
FOR k%=1 TO l%
Destination$=Destination$+CHR$(PEEK(MEM(0+40)+x&+120+k%))
NEXT k%
LONG IF LEN(Subject$) < 37 AND (ASC(Status$) AND 2) = 2 AND UCASE$(LEFT$(Subject$,3)) <> "RE:"
Subject$="Re: "+Subject$
END IF
ahold%=INSTR(1,Destination$,".")
LONG IF ahold% > 0
Point%=Point%+1
ppoint$=MID$(Destination$,ahold%+1,LEN(Destination$))
Destination$=LEFT$(Destination$,ahold%-1)
END IF
FOR jc% = 0 TO AKACnt%
lj%=LEN(AKAName$(jc%))
LONG IF LEFT$(AKAName$(jc%),lj%) = UCASE$(Destination$)
Destination$=AKANode$(jc%)
jc%=999
END IF
NEXT jc%
LONG IF MessageType%=3
Byte2$="M"
Catagory$="000"
XELSE
Byte2$="E"
Catagory$=STR$(Section%)
Catagory$=RIGHT$(Catagory$,LEN(Catagory$)-1)
LONG IF LEN(Catagory$)<3
FOR k%=LEN(Catagory$) TO 2
Catagory$="0"+Catagory$
NEXT k%
END IF
END IF
LONG IF ((ASC(Status$) AND 1) = 1)
Byte1$="D": ' If message is flagged for delete Byte1 $= "D"
XELSE
Byte1$="." ' If message is active the Byte1$ = blank space
END IF
Byte3$="." ' Not used
LONG IF SkipExport%=2 AND MessageType%=4
file%=4
XELSE
file%=5
END IF
LSeen&=LOF(4,1)
ERROR = 0:ErrCode%=21
PRINT #file%,Byte1$;Byte2$;Byte3$;CHR$(13);
PRINT #file%,Catagory$;CHR$(13);
Hold$=Month$+"/"+Day$+"/"+Year$
PRINT #file%,Hold$;CHR$(13);
Hold$=Hour$+":"+Minute$+":"+Second$
PRINT #file%,Hold$;CHR$(13);
PRINT #file%,Destination$;CHR$(13);
PRINT #file%,From$;CHR$(13);
PRINT #file%,To$;CHR$(13);
PRINT #file%,Subject$;CHR$(13);
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
MessageSize&=MessageOffSet&
EBytes&=EBytes&+MessageLength&+9
ERROR = 0 :ErrCode%=22
RECORD #2,0,MessageOffSet&
READ FILE #2,MEM(1+40),MessageLength&
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ERROR = 0 :ErrCode%=23
LONG IF ahold% > 0
MsgLine$=CHR$(1)+"TOPT "+ppoint$
PRINT #file%,MsgLine$;CHR$(13);
END IF
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
y&=0
ERROR = 0 :ErrCode%=24
WHILE MessageSize& < MessageOffSet&+MessageLength&
MsgLine$=""
l%=CVI(CHR$(PEEK(MEM(1+40)+y&)))
FOR k% = 1 TO l%
MsgLine$=MsgLine$+CHR$(PEEK(MEM(1+40)+y&+k%))
NEXT k%
PRINT #file%,MsgLine$;CHR$(13);
MessageSize&=MessageSize&+1+l%
y&=y&+1+l%
WEND
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
LONG IF MessageType%=3 AND b%(4) = 2
LONG IF UCASE$(To$) <> "AREAFIX"
ERROR = 0:ErrCode%=25
PRINT #file%," ";CHR$(13);
ExMsg$="--- Export 3.21"
IF ahold% > 0 THEN ExMsg$=ExMsg$+"/Point"
PRINT #file%,ExMsg$;CHR$(13);
PRINT #file%,OriginLine$;CHR$(13);
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
END IF
END IF
LONG IF MessageType% = 4
ERROR = 0 :ErrCode%=26
IF b%(5) <> 2 AND file% = 4 THEN PRINT #file%," ";CHR$(13);
LONG IF b%(5) = 2
PRINT #file%," ";CHR$(13);
FOR js% = 1 TO 10
LONG IF UCASE$(LEFT$(Sign$(js%),4)) <> "NONE"
PRINT #file%,Sign$(js%);CHR$(13);
SFlag%=1
END IF
NEXT js%
END IF
LONG IF file%=4
IF SFlag%=1 THEN PRINT #file%," ";CHR$(13);
ExMsg$="--- Tabby "+TabbyVersion$+"/Export 3.21"
IF ahold% > 0 THEN ExMsg$=ExMsg$+"/Point"
PRINT #file%,ExMsg$;CHR$(13);
PRINT #file%,OriginLine$;CHR$(13);
END IF
END IF
PRINT #file%,CHR$(0);CHR$(13);
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
LONG IF file%=4
ERROR = 0:ErrCode%=27
bhold$=STR$(LSeen&):bhold$=RIGHT$(bhold$,LEN(bhold$)-1)
PRINT #7,"|";Catagory$;"|n";bhold$;"|SEEN_BY: ";TAddress$;CHR$(13);
PRINT #7,"PATH: ";TAddress$;CHR$(13);
PRINT #7,CHR$(0);CHR$(13);
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
END IF
LONG IF MessageType%=3
NetCount%=NetCount%+1
XELSE
EchoCount%=EchoCount%+1
END IF
ExportCount&=ExportCount&+1
ExportCount%(Section%)=ExportCount%(Section%)+1
RETURN
"Get_Resource_Values"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine Gets default values from STR resources
' 1 is inactive, 2 is active
' 1230 = BBS Application Name (Red Ryder Host)
' 1231 = BBS Folder Pathname (dd80:bbs:)
' 1232 = ImExport Log Full Pathname (dd80:bbs:Log:ImExport Log)
' 1233 = value for last Message Number processed (9650)
' 1234 = value for Netmail Message Section Number (11)
' 1235 = b%(1) Process All
' 1236 = b%(2) Delete Netmail
' 1237 = b%(3) Notify Sysop
' 1238 = b%(4) Append Origin/NetMail
' 1239 = b%(5) Append Signature/EchoMail
' 1240 = b%(6) Activate Reports
' 1241 = b%(7) Use Full Reports
' 1242 = b%(8) Erase Log
' 1243 - 1252 = Signature #1 - #10
' 1253 - 1257 Holding Area for last five Export Stats
' 1258 = Skip Generic Export Flag
' 1259 = AKA File Name/Location
' ----- End Comment
Tabby$="TabbyNet"
TRefnum%=FN OPENRESFILE(Tabby$)
Errnum%=FN RESERROR
LONG IF Errnum% <> 0
TabbyVersion$=""
GOTO "Res_Load"
END IF
StrHnd&=FN GETRESOURCE(CVI("TABY"),0)
LONG IF StrHnd&=0
CALL CLOSERESFILE(TRefnum%)
TabbyVersion$=""
GOTO "Res_Load"
END IF
HoldingArea$=FN ReturnString$(StrHnd&)
x%=VAL(HoldingArea$)
x%=INSTR(1,HoldingArea$,".")
LONG IF MID$(HoldingArea$,x%+2,1) = "."
y$=MID$(HoldingArea$,x%+3,2):y%=VAL(y$):y$=STR$(y%)
TabbyMantissa$=RIGHT$(y$,LEN(y$)-1)
Mantissa%=1
END IF
x$=MID$(HoldingArea$,x%-2,5)
x! = VAL(x$)
x$=STR$(x!)
TabbyVersion$=RIGHT$(x$,LEN(x$)-1)
IF x! > 4.5 OR x! < 2.1 THEN TabbyVersion$="x.x"
IF Mantissa%=1 THEN TabbyVersion$=TabbyVersion$+"."+TabbyMantissa$
CALL CLOSERESFILE(TRefnum%)
"Res_Load"
' Find out what this application is named
GOSUB "Cursor_Spin"
CurApName=&H910
CurApName$=""
FOR I%=1 TO PEEK(CurApName)
CurApName$=CurApName$+CHR$(PEEK(CurApName+I%))
NEXT I%
rscs%=0:' ResFile is Closed
Refnum%=FN OPENRESFILE(CurApName$)
Errnum%=FN RESERROR
LONG IF Errnum% <> 0
ErrCode%=99
GOSUB "Error Log"
GOSUB "Tabby_Launch"
RESET
END
END IF
rscs%=1:' ResFile is Open
FOR ResourceCount%=1230 TO 1259
GOSUB "Cursor_Spin"
StrHnd&=FN GETRESOURCE(CVI("STR "),ResourceCount%)
LONG IF StrHnd&=0
' Setting up string resource to save default strs
IF ResourceCount% = 1230 THEN Str$="Red Ryder Host"
IF ResourceCount% = 1231 THEN Str$=":"
IF ResourceCount% = 1232 THEN Str$="Report Log"
IF ResourceCount% = 1233 THEN Str$="0"
IF ResourceCount% = 1234 THEN Str$="1"
LONG IF ResourceCount% >= 1235 AND ResourceCount% <= 1242
Str$="1"
END IF
LONG IF ResourceCount% >= 1243 AND ResourceCount% <= 1252
Str$="NONE"
END IF
LONG IF ResourceCount% >= 1253 AND ResourceCount% <= 1257
Str$="Blank"
END IF
LONG IF ResourceCount% = 1258
Str$="1"
END IF
LONG IF ResourceCount% = 1259
Str$="ExAKA Nodes"
END IF
StrHnd&=FN NEWSTRING(Str$)
CALL ADDRESOURCE (StrHnd&,CVI("STR "),ResourceCount%,"")
XELSE
StrHnd&=FN GETSTRING(ResourceCount%)
END IF
' Convert STRs into useful limit values and pathnames
Default$=FN ReturnString$(StrHnd&)
IF ResourceCount% = 1230 THEN RRHost$=Default$
IF ResourceCount% = 1231 THEN BBSFolder$=Default$
IF ResourceCount% = 1232 THEN ReportLog$=Default$
IF ResourceCount% = 1233 THEN OldHighMessage&=VAL(Default$):OldHighMessage$=Default$
IF ResourceCount% = 1234 THEN NetMailArea%=VAL(Default$):NetMailArea$=Default$
LONG IF ResourceCount% >= 1235 AND ResourceCount% <= 1242
b%(ResourceCount%-1234)=VAL(Default$)
END IF
LONG IF ResourceCount% >= 1243 AND ResourceCount% <= 1252
Sign$(ResourceCount%-1242) = Default$
END IF
LONG IF ResourceCount% >= 1253 AND ResourceCount% <= 1257
b$(ResourceCount%-1252) = Default$
END IF
IF ResourceCount% = 1258 THEN SkipExport% = VAL(Default$)
IF ResourceCount% = 1259 THEN AKAFile$ = Default$
NEXT ResourceCount%
RETURN
"Get_Tabby_Files"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine reads in the various tabby files from the disk.
' Tabby Files Used: Tabby Config - Node Address
' Generic - Path to Generic Export Folder
' Areas.bbs - Origin Line
' ----- End Comment
ErrCode%=28: ' sets Export error code
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
' Open GENERIC file,and read in the Path to the Generic Export file
OPEN "I",1,GenericFile$
INPUT #1,GenericFile$
CLOSE #1
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ErrCode%=28: ' sets Export error code
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
' Open TABBY CONFIG file, and read in the Path to the Node Address file
OPEN "I",1,TabbyConfig$
LINE INPUT #1,OAddress$
TAddress$=MID$(OAddress$,3,LEN(OAddress$))
' TAddress$ is used if you ship Generic Export and go right to the Generic Ehcoes
CLOSE #1
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
ErrCode%=29: ' sets Export error code
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
' Open Areas.bbs file, and read in the Origin Line for the system
OPEN "I",1,TabbyAreas$
LINE INPUT #1,Origin2$
CLOSE #1
IF ERROR <> 0 THEN ErrHold%=ERROR:GOSUB "ERROR_Check"
OriginLine$ = " * Origin: "+Origin2$+" ("+OAddress$+")"
ERROR = 0
AKACnt%=0
OPEN "I",1,AKAFile$
IF ERROR <> 0 THEN GOTO "AKA_Skip"
WHILE NOT EOF(1)
LINE INPUT #1,lin$
x%=INSTR(1,lin$,":")
AKAName$(AKACnt%) = UCASE$(LEFT$(lin$,x%-1))
AKANode$(AKACnt%) = MID$(lin$,x%+1,LEN(lin$))
AKACnt%=AKACnt%+1
IF AKACnt% = 100 THEN CLOSE #1:GOTO "AKA_Skip"
WEND
CLOSE #1
"AKA_Skip"
ERROR = 0
RETURN
"Error Log"
' Writes a text file, listing the Error that happended
DEF OPEN "TEXTEDIT"
OPEN "A",9,"Export.Error"
PRINT #9," <<Application Error Codes>> - ";Errhold%;",";ErrCode%
PRINT #9,"<<Application Error Message>> - ";ERRMSG$(Errhold%)
PRINT #9," <<System Error Code>> - ";SYSERROR
PRINT #9," <<Free Memory>> - ";MEM(-1)
PRINT #9," "
PRINT #9,"Below is a list of files used by Export 3.x and their locations,"
PRINT #9,"as configured from Export, Config, Generic, Messages. Check to"
PRINT #9,"make sure they have the correct setting in Config, Export, Generic"
PRINT #9,"and the Messages files. Also See Export 3.x Error Codes for info."
PRINT #9," "
PRINT #9," BBS Folder - ";BBSFolder$
PRINT #9," Launch Appl - ";BBSFolder$;Tabby$(0)
PRINT #9," Report Log - ";ReportLog$
PRINT #9," ExAKA Nodes* - ";AKAFile$
PRINT #9," Messages - ";MessagesFile$
PRINT #9," Config - ";ConfigFile$
PRINT #9," Host App - ";RRHost$
PRINT #9," TabbyNet App* - ";TabbyNet$
PRINT #9," Areas.bbs - ";TabbyAreas$
PRINT #9," Tabby Config - ";TabbyConfig$
PRINT #9," Launch.Next* - ";NextLaunch$
PRINT #9,"Generic Folder - ";GenericFile$
PRINT #9,"Generic Export - ";GExport$
PRINT #9,"Generic Import - ";GImport$
PRINT #9,"Generic Echoes - ";GEchoes$
PRINT #9," SeenBy.bbs - ";GSeenby$
PRINT #9," "
PRINT #9," * Indicates that Export DOES NOT need these to run, but warns"
PRINT #9," you in the event they are not located."
PRINT #9," "
PRINT #9," Error Time - ";TIME$;" ";DATE$
PRINT #9,"----------------"
CLOSE #9
RETURN
"Cursor_Spin"
' Changes Cursor, spinning beach ball
Cur%=Cur%+1
IF Cur% > 131 THEN Cur%=128
CURSOR Cur%
RETURN
"Date_Convert"
' Pad 1 digit dates/times with a leading Zero
a$=STR$(a%):a$=RIGHT$(a$,LEN(a$)-1)
LONG IF LEN(a$) < 2
a$="0"+a$
END IF
RETURN
"Build_Main_Window"
' Builds Main Logo Window, at run time and displays Logo PICT
GOSUB "Cursor_Spin"
WINDOW 1,"",(333,40)-(489,87),4
Pict3&=FN GETRESOURCE(CVI("PICT"),212)
PICTURE(0,0),Pict3&
CALL PENNORMAL
PEN 1,1,1,8,19
CIRCLE FILL 130,23,14
RETURN
"ERROR_Check"
GOSUB "Error Log"
LONG IF LErr%=1
RUN RRHost$
END
END IF
GOSUB "Tabby_Launch"
END
RETURN
"Config_Read"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine reads in the RRH/SS CONFIG file from the disk and
' determines where the MESSAGES, CALLERLOG, USERLOG are; and what the
' the default Sysop Name is.
' See pages 116 and 117 of the RRH/SS Manual for file structure.
' ----- End Comment
ErrCode%=30: ' sets Export error code
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
' Open CONFIG file, position pointer and read variables of interest
OPEN "N",6,ConfigFile$
Ln&=LOF(6,1)
LONG IF Ln& = 0
CLOSE #6
Errhold%=ERROR
MessagesFile$="Invalid Config File - "+ConfigFile$+" -"+STR$(Ln&)
GOSUB "ERROR_Check"
END IF
RECORD #6,0,0: ' Position pointer to start of file
READ #6, Ignore$;57
READ #6, UserLog$;41
READ #6, CallerLog$;41
READ #6, MessagesPath$;80
READ #6, Ignore$;98
READ #6, SysopName$;31
CLOSE #6
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
' These checks are to see if variable$ has any length to it. If so
' then we Call Function MakeString, which converts the pascal string
' into a form understandable by ZBasic.
' We get the path to the MESSAGES file here
LONG IF ASC(LEFT$(MessagesPath$,1)) > 0
MessagesFile$=FN MakeString$(MessagesPath$)+":MESSAGES"
XELSE
MessagesFile$=BBSFolder$+"MESSAGES": ' Default location
END IF
' We get the path to the CallerLog file here
LONG IF ASC(LEFT$(CallerLog$,1)) > 0
CallerLog$=FN MakeString$(CallerLog$)+":CallerLog"
XELSE
Callerlog$="": ' No CallerLog file being used
END IF
' We get the path to the UserLog file here
LONG IF ASC(LEFT$(UserLog$,1)) > 0
UserLog$=FN MakeString$(UserLog$)+":UserLog"
XELSE
UserLog$=BBSFolder$+"UserLog": ' Default location
END IF
' We get the Sysop Name here
LONG IF ASC(LEFT$(SysopName$,1)) > 0
SysopName$=FN MakeString$(SysopName$)
XELSE
SysopName$="System Operator": ' Default Sysop Name
END IF
RETURN
"Messages_Read"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine reads in the RRH/SS MESSAGES file from the disk and
' determines where the MSGHDR and MSGTXT file are located; what the
' various message section names are and what TYPE each section is.
' See pages 118 and 119 of the RRH/SS Manual for file structure.
' ----- End Comment
' Clear a block of memory so MESSAGES file can be read in, with 1 read
ERROR = 0
ErrCode%=31: ' sets Export error code
CLEAR 9242,3
' Open MESSAGES file, position pointer, block read and close file
OPEN "N",6,MessagesFile$
Ln&=LOF(6,1)
LONG IF Ln& <> 9242
CLOSE #6
Errhold%=ERROR
MessagesFile$="Invalid Messages File - "+MessagesFile$+" -"+STR$(Ln&)
GOSUB "ERROR_Check"
END IF
RECORD #6,0,0
READ FILE #6,MEM(3+40),9242
CLOSE #6
IF ERROR <> 0 THEN Errhold%=ERROR:GOSUB "ERROR_Check"
' Determine where the MSGHDR and MSGTXT file are located
MsgPath$=""
a%=CVI(CHR$(PEEK(MEM(3+40)))):' Gets the length of the MsgPath Name
FOR j%=1 TO a%
MsgPath$=MsgPath$+CHR$(PEEK(MEM(3+40)+j%))
NEXT j%
' Get Low, High and TotalBytes from the MESSAGES file
LowMessage&=PEEK LONG(MEM(3+40)+50)
HighMessage&=PEEK LONG(MEM(3+40)+54)
MsgTxtBytes&=PEEK LONG(MEM(3+40)+58)
' Determine message section names and message section type. 1 - 255
' possible sections
x&=62: ' OffSet position within the MESSAGES file
FOR j%=1 TO 255
SectionType%=CVI(CHR$(PEEK(MEM(3+40)+x&+35)))
LONG IF SectionType% > 0
a%=CVI(CHR$(PEEK(MEM(3+40)+x&)))
LONG IF a% > 0
FOR k%=1 TO a%
MsgName$(j%)=MsgName$(j%)+CHR$(PEEK(MEM(3+40)+x&+k%))
NEXT k%
END IF
MessageSection$(j%)=RIGHT$(STR$(SectionType%),1)
XELSE
MsgName$(j%)=""
END IF
x&=x&+36: 'Increase OffSet. Each message section is 36 bytes long
NEXT j%
GOSUB "Cursor_Spin"
MsgHdrFilename$=MsgPath$+":"+"MSGHDR": ' Path to MSGHDR file
MsgTxtFilename$=MsgPath$+":"+"MSGTXT": ' Path to MSGTXT file
RETURN
"Tabby_Launch"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine reads in the launch.next file from the disk and
' determines the next application to be launched. If it is not the last
' application in the chain a new launch.next file is written to the
' disk for the next application to use, after it has been launched.
' If it is the last application in the chain then the launch.next file
' is deleted from the disk.
' ----- End Comment
RESET: ' Make sure all file are closed
IF rscs%=1 THEN rscs%=0:CALL CLOSERESFILE(Refnum%)
GOSUB "Cursor_Spin"
EventCount%=0: ' sets the number of events in launch.next to 0
ErrCode%=32: ' sets Export error code
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
' Make a Lunch.next file exists
OPEN "R",1,NextLaunch$
Length&=LOF(1,1)
CLOSE #1
IF ERROR <> 0 THEN LErr%=1:Errhold%=ERROR:GOSUB "ERROR_Check"
' If Launch.next file does not exist then jump to Launch_RRH Routine
LONG IF Length&=0
KILL NextLaunch$
NextLaunch$="Launch.next file was not found - "+NextLaunch$
GOSUB "Error Log"
GOTO "Launch_RRH"
END IF
' Read in event chain into Tabby$()
ERROR = 0:ErrCode%=33
OPEN "I",1,NextLaunch$
WHILE NOT EOF(1)
GOSUB "Cursor_Spin"
INPUT #1,Tabby$(EventCount%)
EventCount%=EventCount%+1
WEND
CLOSE #1
IF ERROR <> 0 THEN LErr%=1:Errhold%=ERROR:GOSUB "ERROR_Check"
GOSUB "Cursor_Spin"
EventCount%=EventCount%-1
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
' If EventCount% = 0 then this is the last event, delete Launch.next file
' Else write Launch.next file back to disk, minus the first event which
' is going to be launched next.
LONG IF EventCount% < 1
ErrCode%=34: ' sets Export error code
KILL NextLaunch$
IF ERROR <> 0 THEN LErr%=1:Errhold%=ERROR:GOSUB "ERROR_Check"
XELSE
ErrCode%=35: ' sets Export error code
OPEN "O",1,NextLaunch$
FOR Count% = 1 TO EventCount%
PRINT #1,Tabby$(Count%);
GOSUB "Cursor_Spin"
LONG IF Tabby$(Count%+1) = ""
PRINT #1,CHR$(13);
XELSE
PRINT #1,",";
END IF
NEXT Count%
CLOSE #1
END IF
IF ERROR <> 0 THEN LErr%=1:Errhold%=ERROR:GOSUB "ERROR_Check"
' Add BBS path to application to be launched
' If the Next Event = "BBS" then next file to launch to Red Ryder Host RRHost$
LaunchFile$=BBSPath$+Tabby$(0)
IF UCASE$(Tabby$(0)) = "BBS" THEN LaunchFile$=RRHost$
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
ErrCode%=36: ' sets Export error code
' Checks to see if LaunchFile exists
OPEN "I",2,LaunchFile$
CLOSE #2
' If it does exist then launch it
LONG IF ERROR = 0
RUN LaunchFile$
END
END IF
GOSUB "Error Log"
"Launch_RRH"
ERROR = 0: ' sets ERROR bit to Zero/No error has occured
ErrCode%=37: ' sets Export error code
' Checks to see if RRHost exists
OPEN "I",2,RRHost$
CLOSE #2
' If it does exist then launch it
LONG IF ERROR = 0
RUN RRHost$
END
END IF
' last chance, of RRHost launch failed, drop to finder
GOSUB "Error Log"
Errhold%=999
GOSUB "Error Log"
END
RETURN
SEGMENT
"Memory_Check"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine checks to make sure there is enough memory to run
' the application. Every attempt is made to find the bare minimum
' memory needed to run the application.
' ----- End Comment
LONG IF m& > n&
a&=329600
XELSE
n&=206000+overhead&
LONG IF m& > n&
a&=206000
XELSE
n&=164800+overhead&
LONG IF m& > n&
a&=164800
XELSE
n&=82400+overhead&
LONG IF m& > n&
a&=82400
XELSE
n&=41200+overhead&
LONG IF m& > n&
a&=41200
XELSE
n&=20600+overhead&
LONG IF m& > n&
a&=20600
XELSE
OPEN "A",9,"Export.Error"
PRINT #9,"*** Not Enough Memory *** "
PRINT #9,"*** Minimum Memory Needed:"+STR$(a&+overhead&) +" *** "
PRINT #9,"*** Max Memory Available:"+STR$(Memory&)+" *** "
CLOSE #9
GOSUB "Get_Resource_Values"
NextLaunch$=BBSFolder$+"Launch.Next"
TabbyNet$=BBSFolder$+"TabbyNet"
RRHost$=BBSFolder$+RRHost$
GOSUB "Tabby_Launch"
END
END IF
END IF
END IF
END IF
END IF
END IF
SEGMENT RETURN
SEGMENT
"Configure_Menu"
' COMMENTS
' Last Modified, by Michael Lininger on 12-22-89.
' This sub-routine allows the user to configure export
' ----- End Comment
Pict&=FN GETRESOURCE(CVI("PICT"),210)
Pict2&=FN GETRESOURCE(CVI("PICT"),211)
CURSOR 0
TEXT 0,12,0,0
wnd%=1:GOSUB "Build_Window"
Field%=1
ON DIALOG GOSUB "Handle_Dialog"
DIALOG ON
"Loop"
DIALOG OFF
LONG IF Button%=1
WINDOW CLOSE #1
RETURN
END IF
LONG IF Button%=2
GOSUB "Resource_Update"
WINDOW CLOSE #1
RETURN
END IF
GOTO "Loop"
"Handle_Dialog"
act%=DIALOG(0):ref%=DIALOG(act%)
LONG IF act%=3
LONG IF window%=3
CALL TEDISPOSE(HelpHndl&) :'Dump the field we created
WINDOW CLOSE #3
END IF
WINDOW ref%
window%=WINDOW(0)
RETURN
END IF
IF act%=5 THEN FN FormatWnd(ref%):RETURN :'Window needs refreshing
IF act%=11 THEN EDIT FIELD ref%
LONG IF WINDOW(0)=1
LONG IF act%=1 AND ref%=13
Button%=2
END IF
LONG IF act%=1 AND ref%=15
Button%=1
END IF
LONG IF act%=1 AND ref%=6
LONG IF b%(6)=2
b%(6)=1
b%(7)=1
b%(8)=1
XELSE
b%(6)=2
END IF
BUTTON 6 ,b%(6)
BUTTON 7 ,b%(7)
BUTTON 8 ,b%(8)
END IF
LONG IF act%=1 AND ref% < 6 AND ref% > 0
LONG IF b%(ref%)=2
b%(ref%)=1
XELSE
b%(ref%)=2
END IF
BUTTON ref% ,b%(ref%)
END IF
LONG IF act%=1 AND ref%=7 OR ref%=8
LONG IF b%(ref%)=2
b%(ref%)=1
XELSE
b%(6)=2
b%(ref%)=2
END IF
BUTTON 6 ,b%(6)
BUTTON ref% ,b%(ref%)
END IF
LONG IF act%=1 AND ref%=17
LONG IF SkipExport%=2
SkipExport%=1
XELSE
SkipExport%=2
END IF
BUTTON 17 ,SkipExport%
END IF
LONG IF act%=1 AND ref%=9
F$=FILES$(1,"APPL",,WD)
RRHost$=F$
Temp$=FN ConvertWDRef$(F$,WD) :'Get path name from function
FOR jp% = LEN(Temp$) TO 1 STEP -1
LONG IF MID$(Temp$,jp%,1)=":"
Temp$ = LEFT$(Temp$,jp%)
jp%=0
END IF
NEXT jp%
BBSFolder$=Temp$
EDIT FIELD #1,RRHost$
EDIT FIELD #2,BBSFolder$
Field%=2
END IF
LONG IF act%=1 AND ref%=10
F$=FILES$(1,"APPL",,WD)
Temp$=FN ConvertWDRef$(F$,WD)
FOR jp% = LEN(Temp$) TO 1 STEP -1
LONG IF MID$(Temp$,jp%,1)=":"
Temp$ = LEFT$(Temp$,jp%)
jp%=0
END IF
NEXT jp%
BBSFolder$=Temp$
EDIT FIELD #2,BBSFolder$
Field%=2
END IF
LONG IF act%=1 AND ref%=11
F$=FILES$(1,"TEXT",,WD)
Temp$=FN ConvertWDRef$(F$,WD)
ReportLog$=Temp$
EDIT FIELD #3,ReportLog$
Field%=3
END IF
LONG IF act%=1 AND ref%=12
name$=FILES$(1,"MSGS",,volume%)
LONG IF name$ = ""
HighMessage&=0
XELSE
OPEN "N",9,name$,9242,volume%
READ #9,trash$;54
READ #9,HighMessage&
CLOSE #9
END IF
OldHighMessage$=STR$(HighMessage&)
EDIT FIELD #4,OldHighMessage$
Field%=4
END IF
LONG IF act%=1 AND ref%=14
RRHost$=EDIT$(1)
BBSFolder$=EDIT$(2)
ReportLog$=EDIT$(3)
OldHighMessage$=EDIT$(4)
NetMailArea$=EDIT$(5)
WINDOW CLOSE #1
wnd%=2
GOSUB "Build_Window"
END IF
LONG IF act%=1 AND ref%=16
WINDOW 3,"Export Help/About",(156,60)-(500,298),17
TEXT 3,9,0,0
PRINT " Memory ";MEM(-1)
t%=0:l%=0:b%=WINDOW(3)-30:r%=WINDOW(2)-1
CALL INSETRECT(t%,20,20)
NextBtn%=17
PICTURE (92,195),Pict2&
FN ScrollingHelp(VARPTR(t%),300,NextBtn%)
window%=WINDOW(0)
TEXT 0,12,0,0
END IF
LONG IF act%=6 OR act%=7
Field%=Field%+1
IF Field%>5 THEN Field%=1
EDIT FIELD #Field%
END IF
LONG IF act%=2
EDIT FIELD #ref%
Field%=ref%
END IF
END IF
LONG IF WINDOW(0)=2
LONG IF act%=1 AND ref%=1 OR act%=4
WINDOW CLOSE #2
wnd%=1
GOSUB "Build_Window"
END IF
LONG IF act%=1 AND ref%=2
FOR jp% = 1 TO 10
Sign$(jp%)=EDIT$(jp%)
NEXT jp%
WINDOW CLOSE #2
wnd%=1
GOSUB "Build_Window"
END IF
LONG IF act%=6 OR act%=7
Field%=Field%+1
IF Field%>10 THEN Field%=1
EDIT FIELD #Field%
END IF
LONG IF act%=2
EDIT FIELD #ref%
Field%=ref%
END IF
END IF
LONG IF WINDOW(0)=3
LONG IF act% = 1 OR act%=4
LONG IF ref%=HelpBtn% OR act%=4
CALL TEDISPOSE(HelpHndl&)
WINDOW CLOSE #3
GOTO "Dialog_End"
END IF
BtnPos%=BUTTON(ref%)-1
SelPos%=PEEK WORD(PEEK LONG(HelpHndl&)+94+BtnPos%*2)
CALL TESETSELECT(SelPos%,SelPos%,HelpHndl&)
CALL TESELVIEW(HelpHndl&)
END IF
END IF
"Dialog_End"
wnd%=WINDOW(0)
window%=WINDOW(0)
RETURN
"Frame_Button"
CALL INSETRECT(t%,-4,-4)
PEN 3,3,1,8,0
CALL FRAMEROUNDRECT(t%,16,16)
CALL INSETRECT(t%,4,4):CALL PENNORMAL
RETURN
"Build_Window"
IF wnd%=1 THEN WINDOW 1,"",(0,15)-(520,343),3
IF wnd%=2 THEN WINDOW 2,"Signature Lines",(11,40)-(498,325),5
GOSUB "Build_Edits"
RETURN
"Format_Window"
CALL PENNORMAL
LONG IF WINDOW(0)=1
CALL PENNORMAL
t%=15:l%=65:b%=298:r%=489:PEN 1,1,,,0
CALL FRAMERECT(t%)
t%=19:l%=69:b%=294:r%=485:PEN 2,2,,,0
CALL FRAMERECT(t%)
t%=145:l%=15:b%=304:r%=141:PEN ,,,,19
CALL PAINTRECT(t%)
t%=145:l%=15:b%=304:r%=141:PEN 1,1,,,0
CALL FRAMERECT(t%)
t%=148:l%=18:b%=301:r%=138:PEN 2,2,,,0
CALL FRAMERECT(t%)
PICTURE (18,148),Pict&
t%=260:l%=412:b%=280:r%=471:GOSUB"Frame_Button"
TEXT 0,12,0,0:t%=31:l%=81:b%=47:r%=151:Temp$="BBS Name:"
CALL TEXTBOX(VARPTR(Temp$)+1,LEN(Temp$),t%,-1)
t%=55:l%=77:b%=71:Temp$="BBS Folder:"
CALL TEXTBOX(VARPTR(Temp$)+1,LEN(Temp$),t%,-1)
t%=81:l%=74:b%=97:Temp$="Report Log:"
CALL TEXTBOX(VARPTR(Temp$)+1,LEN(Temp$),t%,-1)
t%=106:l%=73:b%=122:r%=152:Temp$="Last Msg #:"
CALL TEXTBOX(VARPTR(Temp$)+1,LEN(Temp$),t%,-1)
l%=299:r%=390:Temp$="NetMail Area:"
CALL TEXTBOX(VARPTR(Temp$)+1,LEN(Temp$),t%,-1)
TEXT 0,12,
t%=28:l%=155:b%=50:r%=440:PEN 1,1,1,8,0
CALL FRAMERECT(t%)
t%=53:b%=75
CALL FRAMERECT(t%)
t%=78:b%=100
CALL FRAMERECT(t%)
t%=103:l%=394:b%=125
CALL FRAMERECT(t%)
l%=155:r%=254
CALL FRAMERECT(t%)
PEN 2,2,,,3
PLOT 448,48 TO 466,48
PLOT 471,31 TO 471,45
PLOT 467,48 TO 471,45
PLOT 448,74 TO 466,74
PLOT 471,59 TO 471,71
PLOT 467,74 TO 471,71
PLOT 449,99 TO 466,99
PLOT 471,83 TO 471,95
PLOT 467,99 TO 471,95
PLOT 262,124 TO 280,124
PLOT 284,108 TO 284,120
PLOT 280,124 TO 284,120
PLOT 315,171 TO 466,171
PLOT 471,155 TO 471,167
PLOT 467,171 TO 471,167
PLOT 413,247 TO 466,247
PLOT 471,231 TO 471,244
PLOT 467,247 TO 471,243
PLOT 368,210 TO 466,210
PLOT 471,195 TO 471,207
PLOT 467,210 TO 471,207
END IF
LONG IF WINDOW(0)=2
t%=26:l%=5:b%=48:r%=481:PEN 1,1,1,8
CALL FRAMERECT(t%)
t%=50:b%=72
CALL FRAMERECT(t%)
t%=74:b%=96
CALL FRAMERECT(t%)
t%=98:b%=120
CALL FRAMERECT(t%)
t%=122:b%=144
CALL FRAMERECT(t%)
t%=2:b%=24
CALL FRAMERECT(t%)
t%=146:b%=168
CALL FRAMERECT(t%)
t%=170:b%=192
CALL FRAMERECT(t%)
t%=194:b%=216
CALL FRAMERECT(t%)
t%=218:b%=240
CALL FRAMERECT(t%)
t%=253:l%=392:b%=273:r%=453:GOSUB"Frame_Button"
TEXT 0,12,0,0:t%=256:l%=29:b%=272:r%=285:Temp$="Signature lines for append to Echomail"
CALL TEXTBOX(VARPTR(Temp$)+1,LEN(Temp$),t%, 0)
END IF
CALL PENNORMAL
RETURN
"Build_Edits"
TEXT ,,0,0
LONG IF WINDOW(0)=1
t%=0:l%=0:b%=343:r%=520:PEN ,,,,3
CALL PAINTRECT(t%)
t%=15:l%=65:b%=298:r%=489:PEN ,,,,19
CALL PAINTRECT(t%)
BUTTON 1 ,b%(1),"Process all Msgs",(155,135)-(284,150),2
BUTTON 2 ,b%(2),"Delete NetMail",(155,154)-(272,169),2
BUTTON 3 ,b%(3),"Notify Sysop",(155,173)-(258,188),2
BUTTON 4 ,b%(4),"Append Origin/NetMail",(155,192)-(323,207),2
BUTTON 5 ,b%(5),"Append Signature/EchoMail",(155,211)-(355,226),2
BUTTON 6 ,b%(6),"Activate Log",(155,230)-(257,245),2
BUTTON 7 ,b%(7),"Use Full Stats",(172,249)-(280,264),2
BUTTON 8 ,b%(8),"Erase Log",(172,268)-(255,283),2
BUTTON 17 ,SkipExport%,"Generic Echoes",(270,268)-(390,283),2
EDIT FIELD 1,RRHost$,(157,31)-(438,46),3,1
EDIT FIELD 2,BBSFolder$,(157,56)-(438,71),3,1
EDIT FIELD 3,ReportLog$,(157,81)-(438,96),3,1
EDIT FIELD 4,OldHighMessage$,(157,106)-(252,121),3,1
EDIT FIELD 5,NetMailArea$,(396,106)-(438,121),3,1
BUTTON 9 ,1,"√",(444,28)-(471,48),1
BUTTON 10 ,1,"√",(445,54)-(471,74),1
BUTTON 11 ,1,"√",(446,79)-(471,99),1
BUTTON 12 ,1,"√",(259,104)-(284,124),1
BUTTON 16 ,1,"Help/About",(365,190)-(471,210),1
BUTTON 13 ,1," Save ",(412,260)-(471,280),1
BUTTON 14 ,1,"Configure Signature",(311,151)-(471,171),1
BUTTON 15 ,1,"Cancel",(408,227)-(471,247),1
EDIT FIELD 1
Field%=1
END IF
LONG IF WINDOW(0)=2
TEXT 0,12,
EDIT FIELD 1,Sign$(1),(8,5)-(479,20),3,1
EDIT FIELD 2,Sign$(2),(7,29)-(478,44),3,1
EDIT FIELD 3,Sign$(3),(7,53)-(478,68),3,1
EDIT FIELD 4,Sign$(4),(7,77)-(478,92),3,1
EDIT FIELD 5,Sign$(5),(7,101)-(478,116),3,1
EDIT FIELD 6,Sign$(6),(7,125)-(478,140),3,1
EDIT FIELD 7,Sign$(7),(7,149)-(478,164),3,1
EDIT FIELD 8,Sign$(8),(7,173)-(478,188),3,1
EDIT FIELD 9,Sign$(9),(7,197)-(478,212),3,1
EDIT FIELD 10,Sign$(10),(7,221)-(478,236),3,1
BUTTON 1 ,1,"Cancel",(318,254)-(381,274),1
BUTTON 2 ,1," OK ",(392,253)-(453,273),1
EDIT FIELD 1
Field%=1
END IF
RETURN
"Resource_Update"
a$=EDIT$(2)
Check$=RIGHT$(a$,1)
LONG IF Check$ <> ":"
BBSFolder$=a$+":"
BEEP
Button%=0
EDIT FIELD #2,BBSFolder$
CURSOR 0
GOTO "Loop"
END IF
RCount%=0
FOR ResourceCount%=1230 TO 1234
GOSUB "Cursor_Spin"
RCount%=RCount%+1
default$ = EDIT$(RCount%)
StrHnd&=FN GETRESOURCE(CVI("STR "),ResourceCount%)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
NEXT ResourceCount%
FOR ResourceCount%=1235 TO 1242
GOSUB "Cursor_Spin"
default$ = STR$(b%(ResourceCount%-1234))
StrHnd&=FN GETRESOURCE(CVI("STR "),ResourceCount%)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
NEXT ResourceCount%
FOR ResourceCount%=1243 TO 1252
GOSUB "Cursor_Spin"
default$ = Sign$(ResourceCount%-1242)
StrHnd&=FN GETRESOURCE(CVI("STR "),ResourceCount%)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
NEXT ResourceCount%
GOSUB "Cursor_Spin"
default$ = STR$(SkipExport%)
StrHnd&=FN GETRESOURCE(CVI("STR "),1258)
CALL SETSTRING(StrHnd&,default$)
CALL CHANGEDRESOURCE(StrHnd&)
CALL UPDATERESFILE(Refnum%)
SEGMENT RETURN
Shareware price for mantissa is $30.00.
The following is a list of features in Mantissa 3.2.
Mantissa is a message base management utility, that helps SS/Tabby
sysops maintain the high volume of echo and local mail that enter
and leave their system.
o Each message section can have a unique:
o Day limit (0-999)
o Section Limit (0-999)
o Archive Limit (0-999k)*
o Archive Location (any valid path)*
o Archives can have unique or the same archive paths*
o nonSection messages are automatically deleted*
o Global Limit Set Option*
o Global Day Limit Set Option*
o Global Archive Limit Set Option*
o Global Archive Location Set Option*
o Control 'set' Buttons for Setting unique Pathnames*
o Multiple ways to move from section to section*
o List Manager Scroll Feature*
o Popup Menus*
o Control Button Forward/Reverse*
o Menu Commands*
o Command Keys*
o On Line Help*
o Full Support of Mac Interface
o Delete by Age Only
o Delete by Limit Only
o Delete by both Age/Limit
o Master Archive On/Off switch*
o Individual Delete/Limit ON/OFF Markers*
o Renumber Messages*
o Renumber Forward from message #1*
o Renumber Reverse from high Message No.*
o Renumber Userlog, High message last read*
o Renumber on Specified Dates Only*
o Use STR's or Text file to save settings.*
o Network and Remote Maintenance supported
o Turn Mantissa Log On/Off
o Select Location and Name of Mantissa Log
o Epistle Generator
o On/Off Epistle Generator
o Max. Message Level Show Clearance
o Select location/name of Epistle Report
o Append/Erase Epistle Report
o Keep .Bak's or discard them*
o Security marker for High Clearance sections*
o Major speed boost over 1.0
o Tabby Compatible or Standalone * - New in 3.x version
In addition to Mantissa 3.2 Registered users are provided with the
updated Export 3.2. Export is a utility that is essential if you run
SS and Tabby. Export 3.2 has been greatly expanded and turbo charged.
Sysop are are given extraordinary control over data exported from their
system. Export 3.2, Probe 3.2, PreStamp 3.2 and Sundial 3.2 are only
being made available to Registered Mantissa users.
Options Available in Export 3.2:
o Point Message Support*
o Process all/new Messages*
o Delete NetMail as Processed
o Notify Sysop of Export*
o Summary of Last 5 Exports*
o Append Origin to Netmail
o D'Bridge Areafix support
o Turn Log on/off
o Select location/name of log
o Append directly to Tabby Log
o Full support of mac interface
o Use Short/Long Reports
o Node Alias for Netmail*
o Use Generic Echoes/Seenby.bbs files*
o Compatible with Origin Master (by Lance Rasmussen)
o On Line Help*
o Major speed boost over 2.52
o Erase/Append to Log* * - New in 3.x version
Utilities from, Lininger Technology:
Free to all Registered Mantissa
Versions
Export 2.54 3.2
Import 2.53 2.53 (update soon)
Sundial 2.1 3.2
PreStamp 2.0 3.2
Mantissa 1.0 (demo) 3.2
Probe .53 3.2
R.Prestamp 2.0 2.0 (update soon)
Sapphire 2.1t 2.1t (update soon)
Epistle II 1.0 1.0
TPort 1.0 1.0
*Pleiades (1) -NA- .25 (Phase 1 only)
Special thanks to,
Tom Fitzsimmons, Mark Bryant, Lance Rasmussen & Ralph Merritt
for their great ideas and for risking life and data while beta testing
the above products.
Mantissa($30.00):
Lininger Technology
Suite 'A'
385 Bowling Green Place
Gahanna, Ohio 43230
614-471-6209 226/200
Applications Freq. from 1:226/200 or 1:350/90
For General Release:
Epistle1.sit - Epistle II 1.0
Export25.sit - Export 2.54
Import25.sit - Import 2.53
Mant10.sit - Mantissa 1.0
PreStp20.sit - Prestamp 2.0
Probe.53.sit - Probe .53
RPreSt20.sit - R.Prestamp (Robot)
Sapph21t.sit - Sapphire 2.1t
Sundil21.sit - Sundial 2.1
TPort10.sit - TabbyPort 1.0
TurboT.sit - TurboPascal launch.next source (original by Pete Johnson)
ZLaunch.sit - ZBasic launch.next source code
No password required to get the above files
For Restistered Mantissa Users:
Export32.sit <password> - Export 3.21
Mant32.sit <password> - Mantissa 3.2
PreStp32.sit <password> - PreStamp 3.2
Probe32.sit <password> - Proble 3.2
Sundil32.sit <Password> - Sundial 3.2
<Password> is the first 4 uppercase characters of the filename
mentioned in your Mantissa registration cover letter
that accompanied your master disk.